VERSION 5.00
Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX"
Begin VB.Form frmMPS 
   BackColor       =   &H00FFFFFF&
   Caption         =   "Multi-Piece Shipment"
   ClientHeight    =   5880
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   10815
   Icon            =   "frmMPS.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   ScaleHeight     =   5880
   ScaleWidth      =   10815
   StartUpPosition =   1  'CenterOwner
   Begin VB.CheckBox chkPrintAsAdd 
      BackColor       =   &H00FFFFFF&
      Caption         =   "Print As Packages Are Added"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   4020
      TabIndex        =   13
      Top             =   2400
      Width           =   2835
   End
   Begin VB.ComboBox cboBoxName 
      Height          =   315
      Left            =   3720
      TabIndex        =   6
      Text            =   "Combo1"
      Top             =   1560
      Width           =   1335
   End
   Begin VB.CommandButton cmdShip 
      Appearance      =   0  'Flat
      BackColor       =   &H00C0E0FF&
      Caption         =   "Ship (F12)"
      Height          =   315
      Left            =   3000
      MaskColor       =   &H0080C0FF&
      Style           =   1  'Graphical
      TabIndex        =   14
      Top             =   5400
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdClose 
      Appearance      =   0  'Flat
      BackColor       =   &H00E0E0E0&
      Caption         =   "Close"
      Height          =   315
      Left            =   6600
      MaskColor       =   &H0080C0FF&
      Style           =   1  'Graphical
      TabIndex        =   16
      Top             =   5400
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CheckBox f3018 
      BackColor       =   &H00FFFFFF&
      Caption         =   "Non-Standard Packaging"
      Height          =   285
      Left            =   6960
      TabIndex        =   11
      Top             =   1560
      Width           =   2415
   End
   Begin VB.CommandButton cmdDelete 
      Appearance      =   0  'Flat
      BackColor       =   &H00E0E0E0&
      Caption         =   "Delete All"
      Height          =   315
      Left            =   4800
      MaskColor       =   &H0080C0FF&
      Style           =   1  'Graphical
      TabIndex        =   15
      Top             =   5400
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.TextBox f1 
      Height          =   315
      Left            =   2040
      TabIndex        =   0
      Top             =   480
      Width           =   2415
   End
   Begin VB.TextBox txtNoPkgs 
      Height          =   315
      Left            =   2040
      TabIndex        =   2
      Text            =   "1"
      Top             =   1200
      Width           =   735
   End
   Begin VB.CommandButton cmdAddMPS 
      Appearance      =   0  'Flat
      BackColor       =   &H00E0E0E0&
      Caption         =   "Add To Shipment"
      Height          =   315
      Left            =   6960
      MaskColor       =   &H0080C0FF&
      Style           =   1  'Graphical
      TabIndex        =   12
      Top             =   1920
      UseMaskColor    =   -1  'True
      Width           =   1455
   End
   Begin VB.TextBox f3057 
      Height          =   315
      Left            =   6960
      TabIndex        =   10
      Top             =   1200
      Width           =   3135
   End
   Begin VB.TextBox f3056 
      Height          =   315
      Left            =   6960
      TabIndex        =   9
      Top             =   840
      Width           =   3135
   End
   Begin VB.TextBox f25 
      Height          =   315
      Left            =   6960
      TabIndex        =   8
      Top             =   480
      Width           =   3135
   End
   Begin VB.TextBox f26 
      Height          =   315
      Left            =   2040
      TabIndex        =   7
      Top             =   1920
      Width           =   1095
   End
   Begin VB.TextBox f59 
      Height          =   315
      Left            =   3240
      TabIndex        =   5
      Top             =   1560
      Width           =   375
   End
   Begin VB.TextBox f58 
      Height          =   315
      Left            =   2640
      TabIndex        =   4
      Top             =   1560
      Width           =   375
   End
   Begin VB.TextBox f57 
      Height          =   315
      Left            =   2040
      TabIndex        =   3
      Top             =   1560
      Width           =   375
   End
   Begin VB.TextBox f1670 
      Height          =   315
      Left            =   2040
      TabIndex        =   1
      Top             =   840
      Width           =   735
   End
   Begin MSDataGridLib.DataGrid grdMPS 
      Height          =   2535
      Left            =   360
      TabIndex        =   27
      TabStop         =   0   'False
      ToolTipText     =   "To Delete a Package highlight the row and press the Delete key."
      Top             =   2700
      Width           =   10095
      _ExtentX        =   17806
      _ExtentY        =   4471
      _Version        =   393216
      AllowUpdate     =   -1  'True
      ForeColor       =   0
      HeadLines       =   2
      RowHeight       =   15
      TabAction       =   2
      WrapCellPointer =   -1  'True
      AllowAddNew     =   -1  'True
      AllowDelete     =   -1  'True
      BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Caption         =   "Total Packages: 0"
      ColumnCount     =   2
      BeginProperty Column00 
         DataField       =   ""
         Caption         =   ""
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   1033
            SubFormatType   =   0
         EndProperty
      EndProperty
      BeginProperty Column01 
         DataField       =   ""
         Caption         =   ""
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   1033
            SubFormatType   =   0
         EndProperty
      EndProperty
      SplitCount      =   1
      BeginProperty Split0 
         BeginProperty Column00 
         EndProperty
         BeginProperty Column01 
         EndProperty
      EndProperty
   End
   Begin VB.Line Line6 
      BorderColor     =   &H000080FF&
      BorderWidth     =   2
      X1              =   5400
      X2              =   5400
      Y1              =   240
      Y2              =   2280
   End
   Begin VB.Label Label10 
      BackColor       =   &H00FFFFFF&
      Caption         =   "Reference Information"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000080FF&
      Height          =   255
      Left            =   5760
      TabIndex        =   30
      Top             =   135
      Width           =   2055
   End
   Begin VB.Line Line3 
      BorderColor     =   &H000080FF&
      BorderWidth     =   2
      X1              =   5760
      X2              =   10440
      Y1              =   120
      Y2              =   120
   End
   Begin VB.Label Label50 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFFFF&
      Caption         =   "Order ID:"
      Height          =   255
      Left            =   960
      TabIndex        =   29
      Top             =   540
      Width           =   975
   End
   Begin VB.Label lblNoPkgs 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFFFF&
      Caption         =   "# of Pkgs to Add:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   1
      Left            =   240
      TabIndex        =   28
      Top             =   1260
      Width           =   1695
   End
   Begin VB.Label Label35 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFFFF&
      Caption         =   "P.O. Number:"
      Height          =   255
      Left            =   5760
      TabIndex        =   26
      Top             =   900
      Width           =   1095
   End
   Begin VB.Label Label25 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFFFF&
      Caption         =   "Invoice Number:"
      Height          =   255
      Left            =   5640
      TabIndex        =   25
      Top             =   1260
      Width           =   1215
   End
   Begin VB.Label Label22 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFFFF&
      Caption         =   "Reference:"
      Height          =   255
      Left            =   5760
      TabIndex        =   24
      Top             =   540
      Width           =   1095
   End
   Begin VB.Label Label14 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFFFF&
      Caption         =   "Declared Value:"
      Height          =   255
      Index           =   0
      Left            =   600
      TabIndex        =   23
      Top             =   1980
      Width           =   1335
   End
   Begin VB.Label Label16 
      BackColor       =   &H00FFFFFF&
      Caption         =   "00 x 00 x 00 in."
      ForeColor       =   &H000080FF&
      Height          =   255
      Index           =   0
      Left            =   3840
      TabIndex        =   22
      Top             =   1620
      Width           =   1095
   End
   Begin VB.Label Label17 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFFFF&
      Caption         =   " Dimensions:"
      Height          =   255
      Index           =   0
      Left            =   960
      TabIndex        =   21
      Top             =   1620
      Width           =   975
   End
   Begin VB.Label Label24 
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      Caption         =   "x"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   0
      Left            =   2400
      TabIndex        =   20
      Top             =   1590
      Width           =   255
   End
   Begin VB.Label Label73 
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      Caption         =   "x"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   0
      Left            =   3000
      TabIndex        =   19
      Top             =   1590
      Width           =   255
   End
   Begin VB.Label Label19 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFFFF&
      Caption         =   "Package Weight:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   0
      Left            =   240
      TabIndex        =   18
      Top             =   900
      Width           =   1695
   End
   Begin VB.Label lblPackage 
      BackColor       =   &H00FFFFFF&
      Caption         =   "Package Information"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000080FF&
      Height          =   255
      Left            =   360
      TabIndex        =   17
      Top             =   135
      Width           =   2055
   End
   Begin VB.Line Line1 
      BorderColor     =   &H000080FF&
      BorderWidth     =   2
      X1              =   360
      X2              =   5040
      Y1              =   120
      Y2              =   120
   End
End
Attribute VB_Name = "frmMPS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'
'
'
' 2006-11-07, JFW, Add order to MPS select to preserve package order
'

Option Explicit
'

'General Section


'---------------------------------------------------------------------------------------
' Procedure : cboBoxName_LostFocus()
' DateTime  : 7/7/2004
' Purpose   : DIMs combo. Called on LostFocus to add or update box dims
'---------------------------------------------------------------------------------------
'
Private Sub cboBoxName_LostFocus()
    On Error GoTo EH
    g_strErrorLocation = "frmMPS:cboBoxName_LostFocus"
    
    If cboBoxName <> "" And f57 <> "" And f58 <> "" And f59 <> "" Then
        Call SaveBoxDIMs(cboBoxName, f57, f58, f59)
        Call LoadBoxDIMsCombos(frmShip.cboBoxName(0))
        Call LoadBoxDIMsCombos(frmShip.cboBoxName(1))
        Call LoadBoxDIMsCombos(cboBoxName, cboBoxName)
    End If
    
    Exit Sub

EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation
End Sub
'---------------------------------------------------------------------------------------
' Procedure : chkPrintAsAdd_Click()
' DateTime  : 7/9/2004
' Purpose   : Changes the caption on these buttons depending on whether or not you're
'             printing as pkgs are added.
'---------------------------------------------------------------------------------------
'
Private Sub chkPrintAsAdd_Click()
    
    cmdAddMPS.Caption = IIf(chkPrintAsAdd = 1, "Print", "Add To Shipment")
    If chkPrintAsAdd = 0 Then cmdAddMPS.Enabled = True
    cmdAddMPS.BackColor = IIf(chkPrintAsAdd = 1, &HC0E0FF, &HE0E0E0)
    cmdClose.Caption = IIf(chkPrintAsAdd = 1, "Done", "Close")
    cmdShip.Enabled = IIf(chkPrintAsAdd = 1, False, True)
    cmdShip.BackColor = IIf(chkPrintAsAdd = 1, &HE0E0E0, &HC0E0FF)

End Sub
'---------------------------------------------------------------------------------------
' Procedure : cmdClose_Click()
' DateTime  : 7/9/2004
' Purpose   : Close clicked, hide the form. If printing as pkgs are added clear screens,
'              reset globals, and set MPS boolean to False.
'---------------------------------------------------------------------------------------
'
Private Sub cmdClose_Click()
    
    On Error GoTo EH
    g_strErrorLocation = "frmMPS:cmdClose_Click"
    
    If chkPrintAsAdd Then
        With frmShip
            Call .ClearShipFields
            Call ClearGlobalVars
            g_blnMPS = False
            .StatusBar1.Panels(2) = "Shipment Complete"
        End With
    End If
    
    'Set #pkgs on Ship form. If 0 records set f116 = 1, else use recordcount.
    frmShip.f116 = IIf(g_rsMPS.RecordCount = 0, "1", Str(g_rsMPS.RecordCount))
    
    If g_rsMPS.RecordCount > 0 Then
        frmShip.f1670 = 0
        g_rsMPS.MoveFirst
        While Not g_rsMPS.EOF
            If IsNumeric(g_rsMPS.Fields("g_str1670").Value) Then
                frmShip.f1670 = Val(frmShip.f1670) + Val(g_rsMPS.Fields("g_str1670").Value)
            End If
            g_rsMPS.MoveNext
        Wend
        g_rsMPS.MoveFirst
    End If
    
    If g_rsMPS.RecordCount > 0 Then
        frmShip.f1670.Locked = True
        frmShip.f116.Locked = True
        frmShip.f1670.ToolTipText = "Use Multipiece button"
        frmShip.f116.ToolTipText = "Use Multipiece button"
    Else
        frmShip.f1670.Locked = False
        frmShip.f116.Locked = False
        frmShip.f1670.ToolTipText = ""
        frmShip.f116.ToolTipText = ""
    End If
    
    f1.SetFocus
    Me.Hide
    frmShip.SetFocus
    
    Exit Sub

EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation
End Sub
'---------------------------------------------------------------------------------------
' Procedure : cmdDelete_Click()
' DateTime  : 3/19/2004
' Purpose   : Verifes user wished to delete all pieces in a shipment and if yes, calls
'           : DeleteMPSFromMDB and UpdateMPSGrid.
'---------------------------------------------------------------------------------------
'
Private Sub cmdDelete_Click()
    Dim intRet As Integer

    intRet = MsgBox("Are you sure you wish to delete all pieces in this shipment?", vbYesNo, "Confirm Delete All")
    If intRet = vbYes Then
        Call DeleteMPSFromMDB(f1)
        Call UpdateMPSGrid(f1)
    End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : cmdAddMPS_Click()
' DateTime  : 3/19/2004
' Purpose   : Adds a record to the MPS table for # of pkgs entered then clears some of
'           : the text fields and call UpdateMPSGrid
'---------------------------------------------------------------------------------------
'
Private Sub cmdAddMPS_Click()
    Dim i As Integer
    
    On Error GoTo EH
    g_strErrorLocation = "frmMPS:cmdAddMPS"
    
    'Check to ensure # of pkgs is entered
    If Val(txtNoPkgs) < 1 Then
        MsgBox "Please enter the # of Pkgs to Add.", vbExclamation, "Intl DIMs Error"
        txtNoPkgs.SetFocus
        Exit Sub
    End If
    
    'Don't add if Printing As Adding and no weight entered
    If chkPrintAsAdd = 0 Or Val(f1670) > 0 Then
        'Loop through # of pkgs and add the data to the database
        For i = 1 To txtNoPkgs
            If AddMPSToMDB() < 1 Then
                'Error!
                MsgBox "Package NOT added to database, please try again.", vbApplicationModal Or vbCritical
            End If
        Next i
    End If
    
    
    'Clear some of the fields
    f1670 = ""
    f57 = ""
    f58 = ""
    f59 = ""
    cboBoxName = ""
    f26 = ""
    txtNoPkgs = "1"
    
    'Update the DataGrid Control
    Call UpdateMPSGrid(f1)
    
    'If Print As Pkgs Are Added is selected, Ship labels and delete entries from MDB
    If chkPrintAsAdd Then
        Call cmdShip_Click
    End If
    
    f1670.SetFocus
    
    Exit Sub

EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation
End Sub
'---------------------------------------------------------------------------------------
' Procedure : AddMPSToMDB()
' DateTime  : 3/19/2004
' Purpose   : Adds a record to the MPS database and returns the number of
'             records affected...usually '1'.
'---------------------------------------------------------------------------------------
'
Public Function AddMPSToMDB() As Long
    Dim strSQL As String
    
    On Error GoTo EH
    g_strErrorLocation = "frmMPS:AddMPSToMDB"
    
    'Set the return value to zero in case of a runtime error
    AddMPSToMDB = 0
    
    'Build and execute the SQL statement
    strSQL = "INSERT into MPS VALUES (" & SingleQuotes(f1) & ","
    strSQL = strSQL & SingleQuotes(f1670) & ","
    strSQL = strSQL & SingleQuotes(f57) & ","
    strSQL = strSQL & SingleQuotes(f58) & ","
    strSQL = strSQL & SingleQuotes(f59) & ","
    strSQL = strSQL & SingleQuotes(f26) & ","
    strSQL = strSQL & SingleQuotes(f25) & ","
    strSQL = strSQL & SingleQuotes(f3056) & ","
    strSQL = strSQL & SingleQuotes(f3057) & ","
    strSQL = strSQL & SingleQuotes(f3018) & ","
    strSQL = strSQL & SingleQuotes(Format(Now, "YYYYMMDD HHnnss")) & ")"
    
    g_connFSMSClient.Execute strSQL, AddMPSToMDB

    Exit Function
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation
End Function
'---------------------------------------------------------------------------------------
' Procedure : UpdateMPSGrid()
' DateTime  : 3/19/2004
' Purpose   : Update the datagrid for given OrderID. Also assign column captions.
' Call from : Form_Activate, cmdAddMPS_Click, frmShip.f1_LostFocus,
'             cmdDelete_Click,
'---------------------------------------------------------------------------------------
'
Public Sub UpdateMPSGrid(ByVal strOrderID As String)
    Dim strSQL As String
    
    On Error GoTo EH
    g_strErrorLocation = "frmMPS:UpdateMPSGrid"
    
    'Build and open the recordset
    ' 2006-11-07, JFW, Add order to MPS select to preserve package order
    strSQL = "SELECT * FROM MPS WHERE f1 = '" & strOrderID & "' order by ShipDate"
    
    If g_rsMPS.State = adStateOpen Then g_rsMPS.Close
    
    g_rsMPS.Open strSQL, g_connFSMSClient, adOpenStatic, adLockOptimistic

    Set grdMPS.DataSource = g_rsMPS
    With grdMPS
        .ClearFields
        .ReBind
        .Columns(0).Caption = "OrderID"
        .Columns(1).Caption = "Pkg Wgt"
        .Columns(2).Caption = "Height"
        .Columns(3).Caption = "Width"
        .Columns(4).Caption = "Length"
        .Columns(5).Caption = "Declared Value"
        .Columns(6).Caption = "Reference"
        .Columns(7).Caption = "PO Number"
        .Columns(8).Caption = "Invoice Number"
        .Columns(9).Caption = "NSP Flag"
        .Caption = "Total Packages: " & Str(g_rsMPS.RecordCount)
    End With
    
    'Update #pkgs on Ship screen
    If g_rsMPS.RecordCount > 0 Then
        frmShip.f116 = Str(g_rsMPS.RecordCount)
    End If
    
    Exit Sub
    
EH:
    'Added to ignore "Operation not allowed in this context" error
    If Err.number <> 3219 Then
        MsgBox Err.Description, vbCritical, g_strErrorLocation
    End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : ShipMPS()
' DateTime  : 3/19/2004
' Purpose   : Call frmShip.AssignTextToGlobal then ShipMPS.
'---------------------------------------------------------------------------------------
'
Private Sub cmdShip_Click()
    
    On Error GoTo EH
    g_strErrorLocation = "frmMPS:cmdShip_Click"
    
    f1.SetFocus
    Call UpdateMPSGrid(f1)

    'Assign main form fields to global vars then ship
    Call frmShip.AssignTextToGlobal
    
    'Added 12/02/04 for MPS Ground COD on 1st Piece only
    If frmCOD.chkCOD1stPiece = 1 And frmShip.f27(2) = 1 Then
        Call ShipCODFirstPiece
    Else
        Call ShipMPS
    End If
    
    If chkPrintAsAdd = 0 Then
        ' Me.Hide
        Call cmdClose_Click
    End If
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation
End Sub
'---------------------------------------------------------------------------------------
' Procedure : Form_KeyUp()
' DateTime  : 2/17/2005
' Purpose   : Check for F12 key
'---------------------------------------------------------------------------------------
'
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    'F12 key pressed, Ship pkg
    If KeyCode = 123 And cmdShip.Enabled = True Then
        Call cmdShip_Click
    End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : Form_KeyDown()
' DateTime  : 2/17/2005
' Purpose   : Enter key pressed sends a TAB to move to next field
'---------------------------------------------------------------------------------------
'
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If Not TypeOf Me.ActiveControl Is CommandButton Then
        If Shift = 0 And KeyCode = 13 Then
            SendKeys "{TAB}"
        End If
    End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : ShipMPS()
' DateTime  : 3/19/2004
' Purpose   : If Ground or FHD clear MPS global vars set in frmShip.AssignTextToGlobal
'           : then call SendData(BuildDOMMPSShipTrans), else if Express ship each MPS
'           : individually by looping through g_rsMPS and calling SendData(BuildDomShipTrans)
'           : for each package.
'---------------------------------------------------------------------------------------
'
Public Sub ShipMPS()
    
    On Error GoTo EH
    g_strErrorLocation = "frmMPS:ShipMPS"
   
    If g_rsMPS.RecordCount = 0 Then
        MsgBox "There are no Multi-Piece Shipments for this Order." & vbCrLf _
                & "Please enter MPS information or check Indentical Pkgs.", vbExclamation, "Multi-Piece Shipment Error"
        
        'Enable buttons and show status bar error
        With frmShip
            Call .EnableButtons
            .StatusBar1.Panels(2) = "MPS Error"
        End With
        
        Exit Sub
    End If
    g_str1670 = ""
    g_str57 = ""
    g_str58 = ""
    g_str59 = ""
    g_str26 = ""
    g_str25 = ""
    g_str3056 = ""
    g_str3057 = ""
    g_str3018 = ""
    
    If g_str50 = "US" And g_str117 = "US" Then
        Call SendData(BuildDomMPSShipTrans(frmShip.f1))
    ElseIf g_str50 <> "US" And g_str117 = "US" Then
        Call SendData(BuildIntlMPSShipTrans(frmShip.f1))
    End If
    
    If chkPrintAsAdd = 1 Then
        Call DeleteMPSFromMDB(f1)
        Call UpdateMPSGrid(f1)
    End If
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation
End Sub
'---------------------------------------------------------------------------------------
' Procedure : f1_LostFocus()
' DateTime  : 3/16/2004
' Purpose   : Update datagrid if Order ID is different than the one on frmShip.
'---------------------------------------------------------------------------------------
'
Private Sub f1_LostFocus()
    
    If f1 <> frmShip.f1 Then
        Call UpdateMPSGrid(f1)
        Call GetData(f1)
        frmShip.f1 = f1
    End If
        
End Sub
'---------------------------------------------------------------------------------------
' Procedure : f1670_Change()
' DateTime  : 3/16/2004
' Purpose   : Weight is numeric only
'---------------------------------------------------------------------------------------
'
Private Sub f1670_Change()
    Call NumericOnly(f1670, True)
End Sub
'---------------------------------------------------------------------------------------
' Procedure : f1670_GotFocus()
' DateTime  : 3/16/2004
' Purpose   : If scale is configured, read it
'---------------------------------------------------------------------------------------
'
Private Sub f1670_GotFocus()
    
    On Error GoTo EH
    g_strErrorLocation = "frmMPS:f1670_GotFocus"
    
    With frmSetup
        If .chkScaleConnected = 1 Then
            f1670 = ReadScale(Right(.cmbScalePort, 1))
        End If
    End With
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation

End Sub
'---------------------------------------------------------------------------------------
' Procedure : f26_Change()
' DateTime  : 3/16/2004
' Purpose   : Declared Value is numeric only
'---------------------------------------------------------------------------------------
'
Private Sub f26_Change()
    Call NumericOnly(f26, False)
End Sub
'---------------------------------------------------------------------------------------
' Procedure : f57_Change, f58_Change, f59_Change()
' DateTime  : 3/16/2004
' Purpose   : DIM fields are numeric only with max length of 3
'---------------------------------------------------------------------------------------
'
Private Sub f57_Change()
    Call NumericOnly(f57, False)
    Call CheckLength(f57, 3)
End Sub

Private Sub f58_Change()
    Call NumericOnly(f58, False)
    Call CheckLength(f58, 3)
End Sub
Private Sub f59_Change()
    Call NumericOnly(f59, False)
    Call CheckLength(f59, 3)
End Sub
'---------------------------------------------------------------------------------------
' Procedure : Form_Load()
' DateTime  : 3/16/2004
' Purpose   : Instantiate recordset
'---------------------------------------------------------------------------------------
'
Private Sub Form_Load()
    Set g_rsMPS = New ADODB.Recordset
End Sub
'---------------------------------------------------------------------------------------
' Procedure : Form_Unload()
' DateTime  : 3/16/2004
' Purpose   : Kills objects
'---------------------------------------------------------------------------------------
'
Private Sub Form_Unload(Cancel As Integer)
    Set grdMPS.DataSource = Nothing
    If g_rsMPS.State = adStateOpen Then g_rsMPS.Close
    Set g_rsMPS = Nothing
End Sub
'---------------------------------------------------------------------------------------
' Procedure : Form_Activate()
' DateTime  : 3/16/2004
' Purpose   : Runs when MPS form is active form on screen. Copies default values from
'             form ship and updates datagrid.
'Calls:     : UpdateMPSGrid
'---------------------------------------------------------------------------------------
'
Private Sub Form_Activate()
    On Error GoTo EH
    g_strErrorLocation = "frmMPS:Form_Activate"
    
    With frmShip
        'Set values to the same as the 'Ship' screen
        f26 = .f26
        f25 = .f25
        f3056 = .f3056
        f3057 = .f3057
        f1 = .f1
    End With
    
    'Show DIMs combo if there are items in it
    cboBoxName.Visible = IIf(cboBoxName.ListCount > 0, True, False)
    
    'Update the Datagrid just in case
    Call UpdateMPSGrid(f1)
    
    f1.SetFocus
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation
End Sub

'---------------------------------------------------------------------------------------
' Procedure : grdMPS_AfterColUpdate()
' DateTime  : 7/15/2004
' Modified  : 8/11/2004
' Change    : Added a check for Null before setting the bookmark. This allows records
'             to be added. Also added error handling.
' Purpose   : This commits the changes immediately after a column has been updated.
'             This keeps users from getting "Operation not allowed in this context" error.
'---------------------------------------------------------------------------------------
'
Private Sub grdMPS_AfterColUpdate(ByVal ColIndex As Integer)
    
    On Error GoTo EH
    g_strErrorLocation = "frmMPS:grdMPS_AfterColUpdate"

    If grdMPS.Bookmark >= 0 Then
        grdMPS.Bookmark = grdMPS.Bookmark
    End If
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation
    
End Sub
'---------------------------------------------------------------------------------------
' Procedure : grdMPS_AfterDelete()
' DateTime  : 3/16/2004
' Purpose   : Update recordcount after a record is deleted.
'---------------------------------------------------------------------------------------
'
Private Sub grdMPS_AfterDelete()
    Dim rsQuery As String
    Dim rsMPSCount
    
    On Error GoTo EH
    g_strErrorLocation = "frmMPS:grdMPS_AfterDelete"

    Set rsMPSCount = New ADODB.Recordset
    ' 2006-11-07, JFW, Add order to MPS select to preserve package order
    rsQuery = "SELECT * FROM MPS WHERE f1 = '" & f1 & "' order by ShipDate"
    rsMPSCount.Open rsQuery, g_connFSMSClient, adOpenStatic, adLockOptimistic
    grdMPS.Caption = "Total Packages: " & Str(rsMPSCount.RecordCount - 1)

Release:
    If rsMPSCount.State = adStateOpen Then rsMPSCount.Close
    Set rsMPSCount = Nothing
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation
    Resume Release
    
End Sub
'---------------------------------------------------------------------------------------
' Procedure : grdMPS_BeforeDelete()
' DateTime  : 3/19/2004
' Purpose   : Verify user wishes to delete a record in the MPS grid.
'---------------------------------------------------------------------------------------
'
Private Sub grdMPS_BeforeDelete(Cancel As Integer)
    Dim intResult As Integer
    
    intResult = MsgBox("Are you sure that you want to delete selected record?", vbYesNo, "Delete Confirmation")
   
    If intResult = vbNo Then
        Cancel = True
    End If

End Sub
'---------------------------------------------------------------------------------------
' Procedure : DeleteMPSFromMDB()
' DateTime  : 3/19/2004
' Purpose   : Deletes all pieces in MPS for passed OrderID
'---------------------------------------------------------------------------------------
'
Public Sub DeleteMPSFromMDB(strKey As String)
    
    Dim strSQL As String
    
    On Error GoTo EH
    g_strErrorLocation = "frmMPS:DeleteMPSFromMDB"
    
    'Build and execute the delete query
    strSQL = "DELETE FROM MPS WHERE f1= " & SingleQuotes(strKey)
    g_connFSMSClient.Execute strSQL
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation

End Sub
'---------------------------------------------------------------------------------------
' Procedure : txtNoPkgs_Change()
' DateTime  : 3/19/2004
' Purpose   : # of pkgs is numeric only
'---------------------------------------------------------------------------------------
'
Private Sub txtNoPkgs_Change()
    Call NumericOnly(txtNoPkgs, False)
End Sub
'---------------------------------------------------------------------------------------
' Procedure : cboBoxName_Click()
' DateTime  : 6/19/2004
' Purpose   : Get box DIMs from Dimensions table and assign to DIM fields
'---------------------------------------------------------------------------------------
'
Private Sub cboBoxName_Click()
    Dim rsBoxDIMs As New ADODB.Recordset
    Dim strQuery As String
    strQuery = "SELECT * FROM Dimensions WHERE BoxName = " & SingleQuotes(cboBoxName)
    rsBoxDIMs.Open strQuery, g_connFSMSClient, adOpenStatic, adLockOptimistic
    
    f57 = rsBoxDIMs!g_str57
    f58 = rsBoxDIMs!g_str58
    f59 = rsBoxDIMs!g_str59
    
Release:

    If rsBoxDIMs.State = adStateOpen Then
        rsBoxDIMs.Close
    End If
    Set rsBoxDIMs = Nothing
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation
    Resume Release
    
End Sub
'---------------------------------------------------------------------------------------
' Procedure : ShipCODFirstPiece()
' DateTime  : 8/6/2004
' Purpose   : Called when "COD on First Piece Only" is checked for Ground MPS COD.
'---------------------------------------------------------------------------------------
'
Public Sub ShipCODFirstPiece()
    'Have to clear these vars in case they were set on the main screen
    'since they are multiple occurrence for Ground
    g_str1670 = ""
    g_str57 = ""
    g_str58 = ""
    g_str59 = ""
    g_str26 = ""
    g_str25 = ""
    g_str3056 = ""
    g_str3057 = ""
    g_str3018 = ""
    
    'These control saving of data in g_clsParser
    g_blnCODFirstPiece = True
    g_blnCODNextPiece = False
    'Set to true so screen doesn't clear after first piece
    g_blnMPS = True
    'Controls flow between transactions
    g_blnComplete = False
    Call SendData(BuildCODFirstPieceShipTrans(frmShip.f1))
    'Wait for tranaction to complete
    Do While Not g_blnComplete
        DoEvents
        Call Pause(0.1)
    Loop
    'Reverse the boolean values for pieces after the first.
    g_blnCODFirstPiece = False
    g_blnCODNextPiece = True
    'Clear these again. They'll be passed as multiple occurrence
    g_str26 = ""
    g_str27 = ""
    g_str25 = ""
    g_str3056 = ""
    g_str3057 = ""
    Call SendData(BuildDomMPSShipTrans(frmShip.f1))
    g_blnMPS = False

End Sub
